home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xt / resource.c < prev    next >
C/C++ Source or Header  |  1992-10-23  |  13KB  |  438 lines
  1. #include "xt.h"
  2.  
  3. #include <X11/Xmu/Xmu.h>
  4. #include <X11/Xmu/Converters.h>
  5.  
  6. #include <ctype.h>
  7.  
  8. #define   XtRChar              "Char"
  9. #define   XtRGC                "GC"
  10.  
  11. #define T_Unknown            -1
  12. #define T_String_Or_Symbol   -2
  13. #define T_Callbacklist       -3
  14. #define T_Float              -4
  15. #define T_Backing_Store      -5
  16. #define T_Dimension          -6
  17. #define T_Translations       -7
  18. #define T_Position           -8
  19. #define T_Bitmap             -9
  20. #define T_Cardinal           -10
  21. #define T_Accelerators       -11
  22.  
  23. static Resource_To_Scheme_Type (t) register char *t; {
  24.     if (streq (XtRAcceleratorTable, t))
  25.     return T_Accelerators;
  26.     else if (streq (XtRBackingStore, t))
  27.     return T_Backing_Store;
  28.     else if (streq (XtRBitmap, t))
  29.     return T_Bitmap;
  30.     else if (streq (XtRBoolean, t))
  31.     return T_Boolean;
  32.     else if (streq (XtRCallback, t))
  33.     return T_Callbacklist;
  34.     else if (streq (XtRCardinal, t))
  35.     return T_Cardinal;
  36.     else if (streq (XtRColormap, t))
  37.     return T_Colormap;
  38.     else if (streq (XtRCursor, t))
  39.     return T_Cursor;
  40.     else if (streq (XtRDimension, t))
  41.     return T_Dimension;
  42.     else if (streq (XtRDisplay, t))
  43.     return T_Display;
  44.     else if (streq (XtRFloat, t))
  45.     return T_Float;
  46.     else if (streq (XtRFont, t))
  47.     return T_Font;
  48.     else if (streq (XtRFontStruct, t))
  49.     return T_Font;
  50.     else if (streq (XtRGC, t))
  51.     return T_Gc;
  52.     else if (streq (XtRInt, t))
  53.     return T_Fixnum;
  54.     else if (streq (XtRPixel, t))
  55.     return T_Pixel;
  56.     else if (streq (XtRPixmap, t))
  57.     return T_Pixmap;
  58.     else if (streq (XtRPosition, t))
  59.     return T_Position;
  60.     else if (streq (XtRShort, t))
  61.     return T_Fixnum;
  62.     else if (streq (XtRString, t))
  63.     return T_String_Or_Symbol;
  64.     else if (streq (XtRTranslationTable, t))
  65.     return T_Translations;
  66.     else if (streq (XtRUnsignedChar, t))
  67.     return T_Character;
  68.     else if (streq (XtRChar, t))
  69.     return T_Character;
  70.     else if (streq (XtRWidget, t))
  71.     return T_Widget;
  72.     else if (streq (XtRWindow, t))
  73.     return T_Window;
  74.     return T_Unknown;
  75. }
  76.  
  77. void Get_All_Resources (sub, w, c, rp, np, cp) Widget w; WidgetClass c;
  78.     XtResource **rp; int *np, *cp; {
  79.     XtResource *r, *sr, *cr;
  80.     int nr, snr = 0, cnr = 0;
  81.  
  82.     XtGetResourceList (c, &r, &nr);
  83.     if (sub)
  84.     Get_Sub_Resource_List (c, &sr, (Cardinal *)&snr);
  85.     if (w && XtParent (w))
  86.     XtGetConstraintResourceList (XtClass (XtParent (w)), &cr, &cnr);
  87.     *np = nr + snr + cnr;
  88.     *cp = cnr;
  89.     *rp = (XtResource *)XtMalloc (*np * sizeof (XtResource));
  90.     bcopy ((char *)r, (char *)*rp, nr * sizeof (XtResource));
  91.     XtFree ((char *)r);
  92.     if (snr)
  93.     bcopy ((char *)sr, (char *)(*rp + nr), snr * sizeof (XtResource));
  94.     if (cnr) {
  95.     bcopy ((char *)cr, (char *)(*rp + nr+snr), cnr * sizeof (XtResource));
  96.     XtFree ((char *)cr);
  97.     }
  98. }
  99.  
  100. void Convert_Args (ac, av, to, widget, class) Object *av; ArgList to;
  101.     Widget widget; WidgetClass class; {
  102.     register char *name, *res;
  103.     register i, j, k;
  104.     Object arg, val;
  105.     XtResource *r;
  106.     int nr, nc;
  107.     int st, dt;
  108.     char key[128];
  109.     PFS2X converter;
  110.     char *stmp;
  111.     XrmValue src, dst;
  112.     Declare_C_Strings;
  113.  
  114.     if (ac & 1)
  115.     Primitive_Error ("missing argument value");
  116.     Get_All_Resources (1, widget, class, &r, &nr, &nc);
  117.     /* Note:
  118.      * `r' is not freed in case of error.
  119.      */
  120.     for (i = k = 0; k < ac; i++, k++) {
  121.     arg = av[k];
  122.     Make_C_String (arg, name);
  123.     Make_Resource_Name (name);
  124.     for (j = 0; j < nr && !streq (name, r[j].resource_name); j++)
  125.         ;
  126.     if (j == nr)
  127.         Primitive_Error ("no such resource: ~s", arg);
  128.     if (streq (r[j].resource_class, XtCReadOnly))
  129.         Primitive_Error ("resource is read-only: ~s", arg);
  130.     res = r[j].resource_name;
  131.     val = av[++k];
  132.     st = TYPE(val);
  133.     dt = Resource_To_Scheme_Type (r[j].resource_type);
  134.  
  135.     /* First look for widget class specific converter for
  136.      * this resource, then look for a general converter
  137.      * (first try the name of the resource, then the type):
  138.      */
  139.     if (widget && j >= nr-nc)
  140.         class = XtClass (XtParent (widget));
  141.     sprintf (key, "%s-%s", Class_Name (class), name);
  142.     converter = Find_Converter_To_C (key);
  143.     if (converter || (converter = Find_Converter_To_C (res))
  144.         || (converter = Find_Converter_To_C (r[j].resource_type))) {
  145.         XtArgVal ret = converter (val);
  146.         XtSetArg (to[i], res, ret);
  147.     } else if (dt == T_String_Or_Symbol) {
  148.         Make_C_String (val, stmp);
  149.         XtSetArg (to[i], res, XtNewString (stmp));  /* Never freed! */
  150.     } else if (dt == T_Callbacklist) {
  151.         int n;
  152.         XtCallbackList callbacks;
  153.  
  154.         Check_Callback_List (val);
  155.         n = Fast_Length (val);
  156.         callbacks = (XtCallbackRec *)  /* Never freed! */
  157.             XtMalloc ((n+1) * sizeof (XtCallbackRec));
  158.         callbacks[n].callback = 0;
  159.         callbacks[n].closure = 0;
  160.         Fill_Callbacks (val, callbacks, n,
  161.         Find_Callback_Converter (class, name, arg));
  162.         XtSetArg (to[i], res, callbacks);
  163.     } else if (dt == T_Float) {
  164.         float f = (float)Get_Double (val);
  165.         to[i].name = res;
  166.         bcopy ((char *)&f, (char *)&to[i].value, sizeof f);
  167.     } else if (dt == T_Dimension || dt == T_Position || dt == T_Cardinal) {
  168.         XtSetArg (to[i], res, Get_Integer (val));
  169.     } else if (dt == T_Backing_Store) {
  170.         XtSetArg (to[i], res, Symbols_To_Bits (val, 0,
  171.         Backing_Store_Syms));
  172.     } else if (dt == T_Translations) {
  173.         XtSetArg (to[i], res, Get_Translations (val));
  174.     } else if (dt == T_Accelerators) {
  175.         XtSetArg (to[i], res, Get_Accelerators (val));
  176.     } else if ((dt == T_Bitmap || dt == T_Pixmap) && EQ(val, Sym_None)) {
  177.         XtSetArg (to[i], res, None);
  178.     } else if (dt == T_Bitmap) {
  179.         /* Should check depth here (must be 1), but how? */
  180.         XtSetArg (to[i], res, Get_Pixmap (val));
  181.     } else {
  182.         if (st != dt) {
  183.         char msg[128];
  184.  
  185.         /* Try to let XtConvert() do the conversion.
  186.          */
  187.         if (widget && (st == T_String || st == T_Symbol)) {
  188.             Make_C_String (val, stmp);
  189.             src.size = strlen (stmp);
  190.             src.addr = (caddr_t)stmp;
  191.             XtConvert (widget, (String)XtRString, &src,
  192.             r[j].resource_type, &dst);
  193.             if (dst.addr) {
  194.             if (dst.size == (sizeof (unsigned char))) {
  195.                 XtSetArg (to[i], res, *(unsigned char *)dst.addr);
  196.             } else if (dst.size == sizeof (XtArgVal)) {
  197.                 XtSetArg (to[i], res, *(XtArgVal *)dst.addr);
  198.             } else {
  199.                 sprintf (msg,
  200.                 "%s: converter for %s returned weird size %d",
  201.                 name, r[j].resource_type, dst.size);
  202.                 Primitive_Error (msg);
  203.             }
  204.             goto done;
  205.             }
  206.         }
  207.         sprintf (msg, "%s: can't convert %s ~s to %s", name,
  208.             Types[st].name, r[j].resource_type);
  209.         Primitive_Error (msg, val);
  210.         }
  211.         if (dt == T_Boolean) {
  212.         XtSetArg (to[i], res, EQ(val, True));
  213.         } else if (dt == T_Colormap) {
  214.         XtSetArg (to[i], res, COLORMAP(val)->cm);
  215.         } else if (dt == T_Cursor) {
  216.         XtSetArg (to[i], res, CURSOR(val)->cursor);
  217.         } else if (dt == T_Fixnum) {
  218.         XtSetArg (to[i], res, FIXNUM(val));
  219.         } else if (dt == T_Display) {
  220.         XtSetArg (to[i], res, DISPLAY(val)->dpy);
  221.         } else if (dt == T_Font) {
  222.         Open_Font_Maybe (val);
  223.         if (streq (r[j].resource_type, XtRFontStruct))
  224.             XtSetArg (to[i], res, FONT(val)->info);
  225.         else
  226.             XtSetArg (to[i], res, FONT(val)->id);
  227.         } else if (dt == T_Pixel) {
  228.         XtSetArg (to[i], res, PIXEL(val)->pix);
  229.         } else if (dt == T_Pixmap) {
  230.         XtSetArg (to[i], res, PIXMAP(val)->pm);
  231.         } else if (dt == T_Gc) {
  232.         XtSetArg (to[i], res, GCONTEXT(val)->gc);
  233.         } else if (dt == T_Character) {
  234.         XtSetArg (to[i], res, CHAR(val));
  235.         } else if (dt == T_Widget) {
  236.         XtSetArg (to[i], res, WIDGET(val)->widget);
  237.         } else if (dt == T_Window) {
  238.         XtSetArg (to[i], res, WINDOW(val)->win);
  239.         } else Panic ("bad conversion type");
  240.     } 
  241. done: ;
  242.     }
  243.     Dispose_C_Strings;
  244.     XtFree ((char *)r);
  245. }
  246.  
  247. Object Get_Values (w, ac, av) Widget w; Object *av; {
  248.     register char *name;
  249.     register i, j;
  250.     Object arg;
  251.     XtResource *r;
  252.     int nr, nc;
  253.     int t;
  254.     ArgList argl;
  255.     Object ret, tail;
  256.     Display *dpy;
  257.     char key[128];
  258.     PFX2S converter;
  259.     Widget w2;
  260.     GC_Node2;
  261.     Declare_C_Strings;
  262.  
  263.     Alloca (argl, Arg*, ac * sizeof (Arg));
  264.     Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc);
  265.     /* Note:
  266.      * `r' is not freed in case of error.
  267.      */
  268.     for (i = 0; i < ac; i++) {
  269.     XtArgVal argval;
  270.  
  271.     arg = av[i];
  272.     Check_Type (arg, T_Symbol);
  273.     Make_C_String (arg, name);
  274.     Make_Resource_Name (name);
  275.     for (j = 0; j < nr && !streq (name, r[j].resource_name); j++)
  276.         ;
  277.     if (j == nr)
  278.         Primitive_Error ("no such resource: ~s", arg);
  279.     argl[i].name = name;
  280.     Alloca (argval, XtArgVal, r[j].resource_size);
  281.     argl[i].value = argval;
  282.     }
  283.     XtGetValues (w, argl, (Cardinal)ac);
  284.     ret = tail = P_Make_List (Make_Fixnum (ac), Null);
  285.     GC_Link2 (ret, tail);
  286.     /*
  287.      * Display is needed for resources like cursor and pixmap.
  288.      * XtDisplay(w) is not necessarily the right one!
  289.      */
  290.     dpy = XtDisplay (w);
  291.     for (i = 0; i < ac; i++, tail = Cdr (tail)) {
  292.     Object o;
  293.     XtArgVal val = argl[i].value;
  294.     for (j = 0; j < nr && !streq (argl[i].name, r[j].resource_name); j++)
  295.         ;
  296.     t = Resource_To_Scheme_Type (r[j].resource_type);
  297.  
  298.     /* Look for a widget class specific converter, then for a
  299.      * general converter (first try the resource name, then the type):
  300.      */
  301.     w2 = (j >= nr-nc) ? XtParent (w) : w;
  302.     sprintf (key, "%s-%s", Class_Name (XtClass (w2)), argl[i].name);
  303.     converter = Find_Converter_To_Scheme (key);
  304.  
  305.     if (converter) {
  306.         o = converter (*(XtArgVal *)val);
  307.     } else if (converter = Find_Converter_To_Scheme (argl[i].name)) {
  308.         o = converter (*(XtArgVal *)val);
  309.     } else if (converter = Find_Converter_To_Scheme (r[j].resource_type)) {
  310.         o = converter (*(XtArgVal *)val);
  311.     } else if (t == T_String_Or_Symbol) {
  312.         char *s = *(char **)val;
  313.  
  314.         if (s == 0) s = "";
  315.         o = Make_String (s, strlen (s));
  316.     } else if (t == T_Callbacklist) {
  317.         register i, n;
  318.         Object ret, tail;
  319.         XtCallbackList callbacks = *(XtCallbackList *)val;
  320.         GC_Node;
  321.  
  322.         for (n = 0; callbacks[n].callback; n++)
  323.         ;
  324.         ret = tail = P_Make_List (Make_Fixnum (n), Null);
  325.         GC_Link2 (ret, tail);
  326.         for (i = 0; i < n; i++, tail = Cdr (tail))
  327.         Car (tail) = Get_Callbackfun (callbacks[i].closure);
  328.         GC_Unlink;
  329.         o = ret;
  330.     } else if (t == T_Float) {
  331.         o = Make_Reduced_Flonum ((double)*(float *)val);
  332.     } else if (t == T_Backing_Store) {
  333.         o = Bits_To_Symbols ((unsigned long)*(int *)val, 0,
  334.         Backing_Store_Syms);
  335.         if (Nullp (o))
  336.         Primitive_Error ("invalid backing-store (Xt bug)");
  337.     } else if (t == T_Boolean) {
  338.         o = (Boolean)*(Boolean *)val ? True : False;
  339.     } else if (t == T_Colormap) {
  340.         o = Make_Colormap (0, dpy, *(Colormap *)val);
  341.     } else if (t == T_Cursor) {
  342.         o = Make_Cursor_Foreign (dpy, *(Cursor *)val);
  343.     } else if (t == T_Gc) {
  344.         o = Make_Gc (0, dpy, *(GC *)val);
  345.     } else if (t == T_Dimension) {
  346.         o = Make_Integer (*(Dimension *)val);
  347.     } else if (t == T_Position) {
  348.         o = Make_Integer (*(Position *)val);
  349.     } else if (t == T_Cardinal) {
  350.         o = Make_Unsigned (*(Cardinal *)val);
  351.     } else if (t == T_Fixnum) {
  352.         if (streq (r[j].resource_type, XtRInt))
  353.         o = Make_Integer (*(int *)val);
  354.         else
  355.         o = Make_Integer (*(short *)val);
  356.     } else if (t == T_Display) {
  357.         o = Make_Display (0, dpy);
  358.     } else if (t == T_Font) {
  359.         if (streq (r[j].resource_type, XtRFontStruct)) {
  360.         o = Make_Font_Foreign (dpy, False, (Font)0,
  361.             *(XFontStruct **)val);
  362.         } else {
  363.         XFontStruct *info;
  364.         Disable_Interrupts;
  365.         info = XQueryFont (dpy, *(Font *)val);
  366.         Enable_Interrupts;
  367.         o = Make_Font_Foreign (dpy, False, *(Font *)val, info);
  368.         }
  369.     } else if (t == T_Pixel) {
  370.         o = Make_Pixel (*(unsigned long *)val);
  371.     } else if (t == T_Pixmap || t == T_Bitmap) {
  372.         o = Make_Pixmap_Foreign (dpy, *(Pixmap *)val);
  373.     } else if (t == T_Character) {
  374.         o = Make_Char (*(unsigned char *)val);
  375.     } else if (t == T_Widget) {
  376.         o = Make_Widget_Foreign (*(Widget *)val);
  377.     } else if (t == T_Window) {
  378.         o = Make_Window (0, dpy, *(Window *)val);
  379.     } else {
  380.         char s[128];
  381.  
  382.         sprintf (s, "%s: no converter for %s", argl[i].name,
  383.         r[j].resource_type);
  384.         Primitive_Error (s);
  385.     }
  386.     Car (tail) = o;
  387.     }
  388.     XtFree ((char *)r);
  389.     GC_Unlink;
  390.     Dispose_C_Strings;
  391.     return ret;
  392. }
  393.  
  394. /* Convert `mapped-when-managed' to `mappedWhenManaged'.
  395.  */
  396. void Make_Resource_Name (s) register char *s; {
  397.     register char *p;
  398.  
  399.     for (p = s; *s; ) {
  400.     if (*s == '-') {
  401.         if (*++s) {
  402.         if (islower (*s))
  403.             *s = toupper (*s);
  404.         *p++ = *s++;
  405.         }
  406.     } else *p++ = *s++;
  407.     }
  408.     *p = '\0';
  409. }
  410.  
  411. Object Get_Resources (c, fun, freeit) WidgetClass c; void (*fun)(); {
  412.     XtResource *r;
  413.     register XtResource *p;
  414.     int nr;
  415.     Object ret, tail, tail2, x;
  416.     GC_Node3;
  417.     
  418.     fun (c, &r, &nr);
  419.     /* Note:
  420.      * `r' is not freed in case of error.
  421.      */
  422.     ret = tail = tail2 = P_Make_List (Make_Fixnum (nr), Null);
  423.     GC_Link3 (ret, tail, tail2);
  424.     for (p = r; p < r+nr; p++, tail = Cdr (tail)) {
  425.     x = tail2 = P_Make_List (Make_Fixnum (3), Null);
  426.     Car (tail) = tail2 = x;
  427.     x = Intern (p->resource_name);
  428.     Car (tail2) = x; tail2 = Cdr (tail2);
  429.     x = Intern (p->resource_class);
  430.     Car (tail2) = x; tail2 = Cdr (tail2);
  431.     x = Intern (p->resource_type);
  432.     Car (tail2) = x;
  433.     }
  434.     GC_Unlink;
  435.     if (freeit) XtFree ((char *)r);
  436.     return ret;
  437. }
  438.